home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue28 / clinic / EDITUNDO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-11-09  |  2.9 KB  |  113 lines
  1. unit EditUndo;
  2.  
  3. interface
  4.  
  5. uses
  6.   WinProcs, WinTypes, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls;
  8.  
  9. type
  10.   TEditUndo = class(TEdit)
  11.   private
  12.     { These fields will be initialised to False, an empty }
  13.     { string and zero respectively without any intervention }
  14.  
  15.     { To avoid unwanted calls to our additional code }
  16.     FInternalOverwrite: Boolean;
  17.     { Saved version of old Text property }
  18.     FText: String;
  19.     { Saved version of old SelStart property }
  20.     FSelStart,
  21.     { Saved version of old SelLength property }
  22.     FSelLength,
  23.     { Length of replacement text }
  24.     FReplaceLength: Integer;
  25.     procedure SaveContents(NewText: PChar);
  26.     procedure RestoreContents;
  27.   protected
  28.     { Called if Text property written to }
  29.     procedure WMSetText(var Msg: TMessage);
  30.       message wm_SetText;
  31.     { Called if SelText property written to }
  32.     procedure EMReplaceSel(var Msg: TMessage);
  33.       message em_ReplaceSel;
  34.     { Called when Ctrl-Z pressed }
  35.     procedure EMUndo(var Msg: TMessage);
  36.       message em_Undo;
  37.   end;
  38.  
  39. procedure Register;
  40.  
  41. implementation
  42.  
  43. procedure TEditUndo.SaveContents(NewText: PChar);
  44. begin
  45.   FText := Text;
  46.   FSelStart := SelStart;
  47.   FSelLength := SelLength;
  48.   { Need to keep record of length of replacement }
  49.   { text to ensure highlighting works when you }
  50.   { repeatedly press the Undo key combination }
  51.   FReplaceLength := StrLen(NewText)
  52. end;
  53.  
  54. procedure TEditUndo.RestoreContents;
  55. var
  56.   TmpText: String;
  57. begin
  58.   { Need to ensure we can undo the undo }
  59.   { i.e. perform a redo operation }
  60.  
  61.   { Swap saved text with current text }
  62.   TmpText := Text;
  63.   { Writing to Text will generate a wm_SetText message }
  64.   { which we don't want to trap ourselves this time }
  65.   FInternalOverwrite := True;
  66.   Text := FText;
  67.   FText := TmpText;
  68.   FInternalOverwrite := False;
  69.  
  70.   { Restore old highlight}
  71.   SelStart := FSelStart;
  72.   SelLength := FSelLength;
  73.  
  74.   { Update other fields accordingly }
  75.   FSelLength := FReplaceLength;
  76.   FReplaceLength := SelLength;
  77. end;
  78.  
  79. procedure TEditUndo.WMSetText(var Msg: TMessage);
  80. begin
  81.   { The em_Undo property causes this to be called }
  82.   { in addition to external access to Text property. }
  83.   { Avoid doing this saving when not required }
  84.   if not FInternalOverwrite then
  85.     SaveContents(PChar(Msg.LParam));
  86.   inherited;
  87. end;
  88.  
  89. procedure TEditUndo.EMReplaceSel(var Msg: TMessage);
  90. begin
  91.   SaveContents(PChar(Msg.LParam));
  92.   inherited;
  93. end;
  94.  
  95. procedure TEditUndo.EMUndo(var Msg: TMessage);
  96. begin
  97.   { This condition will only be true if we have done }
  98.   { our saving code, cos then the edit says it }
  99.   { cannot undo itself, but FText will have a value }
  100.   if not LongBool(Perform(em_CanUndo, 0, 0)) and
  101.      (FText <> '') then
  102.     RestoreContents
  103.   else
  104.     inherited;
  105. end;
  106.  
  107. procedure Register;
  108. begin
  109.   RegisterComponents('Clinic', [TEditUndo]);
  110. end;
  111.  
  112. end.
  113.